home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / yerk / mps231ss.hqx / Mops source / Module source / DialogMod.txt < prev    next >
Text File  |  1993-02-07  |  4KB  |  182 lines
  1. \ Dialog class.
  2.  
  3. \ July 91  mrh    Moved to a module, and migrated some methods from Dialog+.
  4.  
  5.  
  6. \ Class Dialog handles modal dialogs.  For modeless dialogs, use the
  7. \ subclass Dialog+.
  8.  
  9. :class    DIALOG    super{ x-array }
  10.  
  11.     int        RESID
  12.     ptr        DLGPTR
  13.     var        PROCPTR
  14.     int        BOLDITEM
  15.  
  16. :m DLGPTR:
  17.     inline{ get: dlgPtr}
  18.     get: dlgPtr  ;m
  19.  
  20. :m CLOSE:
  21.     nil?: dlgPtr  ?EXIT
  22.     get: dlgPtr  call DisposDialog
  23.     clear: dlgPtr  ;m
  24.  
  25. :m OPEN?:
  26.     nil?: dlgPtr  ;m
  27.  
  28. :m ITEMHANDLE:  { item# -- hndl }
  29.     get: dlgPtr  item# makeInt
  30.     addr: itemType  addr: itemHandle  addr: tempRect
  31.     call GetDItem  get: itemHandle  ;m
  32.  
  33. :m DRAWBOLD:
  34.     nil?: dlgPtr  ?EXIT
  35.     get: boldItem  ?dup  0EXIT
  36.     savePort
  37.     get: dlgPtr  call setPort  3 3 pack  call Pensize
  38.     itemHandle: self  drop            \ Sets up tempRect
  39.     -4 -4 inset: tempRect
  40.     addr: tempRect  16 16 pack  call FrameRoundRect  call PenNormal
  41.     restPort  ;m
  42.  
  43. :m GETNEW:
  44.     0  int: resid  0  -1  call GetNewDialog  put: dlgPtr
  45.     drawBold: self  ;m
  46.  
  47.  
  48. :m SETPROC:        \ ( xt -- )  set dialog proc
  49.     put: procPtr  ;m
  50.  
  51. :m MODAL:
  52.     BEGIN
  53.         get: procPtr  addr: theItem  call ModalDialog
  54.         get: theItem 1- exec: super
  55.         rtm  false -> rtm
  56.     NUNTIL  ;m
  57.  
  58.  
  59. :m PUTITEM:        \ ( val item# -- )
  60.     itemHandle: self  swap makeint  call SetCtlValue  ;m
  61.  
  62. :m GETITEM:        \ ( item# -- val )  Gets value for an item#
  63.     itemHandle: self  >r  word0  r>
  64.     call GetCtlValue  word0  ;m
  65.  
  66. :m PUTRESID:    \ ( resID -- )
  67.     put: resID  ;m
  68.  
  69. :m INIT:    \ ( xt1 ... xtN N resID -- )
  70.     put: resID  put: super  ;m
  71.  
  72. :m SETBOLD:    \ ( item# -- )  Causes bold outline of the specified item
  73.     put: boldItem  ;m
  74.  
  75. :m GETTEXT:    \ ( item# -- addr len )  Returns a text item's text
  76.     itemHandle: self  buf255  get: ItemType 24 and
  77.     IF  call GetIText  ELSE  call GetCTitle  THEN
  78.     buf255 count  ;m
  79.  
  80. :m PUTTEXT: { addr len item# -- }  \ Stores an item's text
  81.     item#  itemHandle: self
  82.     addr len str255   get: ItemType 24 and
  83.     IF  call SetIText  ELSE  call SetCTitle  THEN  ;m
  84.  
  85. :m SETSELECT:  { start end item# -- }
  86.         \ Sets the selection range for text item
  87.     get: dlgPtr
  88.     item# makeInt start end pack  call SeliText  ;m
  89.  
  90. :m DRAW:    \ Forces drawing of dialog before going to modal:
  91.     get: dlgPtr  call DrawDialog  ;m
  92.  
  93.  
  94. \    ====== Extra methods for manipulating dialog items ======
  95.  
  96.  
  97. :m HIDEITEM:    \ ( item# -- )
  98.     get: dlgPtr  swap makeInt  call HideDItem  ;m
  99.  
  100. :m SHOWITEM:    \ ( item# -- )
  101.     get: dlgPtr  swap makeInt  call ShowDItem  ;m
  102.  
  103. :m DISABLEITEM:    \ ( item# -- )
  104.     itemHandle: self  w 254  call HiliteControl  ;m
  105.  
  106. :m ENABLEITEM:    \ ( item# -- )
  107.     itemHandle: self  word0  call HiliteControl  ;m
  108.  
  109. :m SETUSERPROC:  { ^proc item# -- }
  110.     get: dlgPtr  item# makeint
  111.     addr: itemType  addr: itemHandle  tempRect
  112.     call GetDitem
  113.     get: dlgPtr  item# makeint  word0  ^proc  tempRect
  114.     call SetDitem  ;m
  115.  
  116.  
  117. :m HITBOLD:
  118.     get: boldItem  dup  NIF  drop  EXIT  THEN
  119.     1-  exec: self  ;m
  120.  
  121. :m KEY:        \ ( -- b )
  122.         \ Called when a key down event occurs with this dialog's
  123.         \ window active.  Returns false if we've handled the key
  124.         \ here, so no further action is required.  Subclasses can
  125.         \ have customized KEY: methods; here we just provide a
  126.         \ hopefully sensible default action - namely, we treat a
  127.         \ Return or Enter as a click on the bold item, and ignore
  128.         \ all other keys.
  129.  
  130.     msg: fEvent  $ FF and  ( char typed )
  131.     dup 3 =  swap RET =  or
  132.     IF    \ Return or Enter typed - treat as click on bold item
  133.         hitBold: self  false  EXIT
  134.     THEN
  135.     true  ;m
  136.  
  137. :m TITLE:    \ ( addr len -- )
  138.     str255
  139.     get: dlgPtr  swap  call SetWTitle  ;m
  140.  
  141. :m MAXX:    \ ( -- x )
  142.     get: dlgPtr  maxX: window  ;m
  143.  
  144. :m MAXY:
  145.     get: dlgPtr  maxY: window  ;m
  146.  
  147. :m MOVE:    \ ( x y -- )
  148.     get: dlgPtr  move: window  ;m
  149.  
  150. :m CENTER:
  151.     get: dlgPtr  center: window  ;m
  152.  
  153. \            =================
  154.  
  155. :m SHOW:
  156.     get: dlgPtr  call ShowWindow  ;m
  157.  
  158. :m HIDE:
  159.     get: dlgPtr  call HideWindow  ;m
  160.  
  161. :m SELECT:
  162.     get: dlgPtr  call SelectWindow  ;m
  163.  
  164.  
  165. :m CLASSINIT:    \ Initializes default handlers to close the dialog box.
  166.     ['] closer  fill: self  ;m
  167.  
  168. ;class
  169.  
  170.  
  171. : TOGITEM    \ Toggles the check box or radio button
  172.     get: theItem  1 over  getitem: caller  -  swap  putitem: caller
  173.     returnToModal  ;
  174.  
  175.  
  176. : PARAMTEXT ( addr0 len0 addr1 len1 addr2 len2 addr3 len3 ) { \ p1 p2 p3 -- }
  177.         \ Substitutes Dialog text.
  178.      str255 dup -> p3  count +
  179.     >str255 dup -> p2  count +
  180.     >str255 dup -> p1  count +
  181.     >str255  p1 p2 p3  call ParamText  ;
  182.